home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bonus.arc / DOME.LSP < prev    next >
Encoding:
Text File  |  1986-02-17  |  807 b   |  36 lines
  1. (defun c:DOME ()
  2. (setq cen (getpoint "centre point: "))
  3. (setq r (getdist "radius: "))
  4. (setq d (getint "step resolution <8>: "))
  5. (if (= d nil) (setq d 8))
  6. (setq e1 (getvar "elevation"))
  7. (setq t1 (getvar "thickness"))
  8. (setq t (setvar "thickness" (/ r d)))
  9. (command "CIRCLE" cen r)
  10. (setq ra r)
  11. (setq ta t)
  12. (setq ea e1)
  13. (setq y t)
  14. (defun STEPA ()
  15. (setq ea (setvar "elevation" (+ ea ta)))
  16. (setq ta (setvar "thickness" (* ta 0.92)))
  17. (setq y (+ y ta))
  18. (setq a (* 4 y y))
  19. (setq b (* 4 r r))
  20. (setq k (- b a))
  21. (setq m (sqrt k))
  22. (setq f (* 2 r))
  23. (setq p (- f m))
  24. (setq x (/ p 2))
  25. (setq ra (- r x))
  26. (command "CIRCLE" cen ra)
  27. )
  28. (defun REP ()
  29. (setq v (- (+ e1 r) ea))
  30. (if (>= v (* 1.92 ta)) (stepa))
  31. )
  32. (setq n (* d 3))
  33. (repeat n (rep))
  34. (setvar "elevation" e1)
  35. (setvar "thickness" t1)
  36. )